Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE20/CACHE/CachedCalendar.pas

Pascal/Delphi Source File | 1997-02-06 | 10.9 KB | 348 lines

unit CachedCalendar;
{
  Author : Neil McClements
  Date   : January '97
  C/right: (c) 1997 N. McClements
  Purpose: A data-aware calendar with the ability to cache dates and occasions
           using file streams
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Calendar,DBCtrls, DBTables, DB, Menus;

//
//  TSpecialDateList is used to hold each date and its occasion. It would be
//  possible to store multiplke occasions against the same date by altering the
//  properties Date and Occasion to use TStringLists or other data structure.
//

type TSpecialDateList=class(TComponent)
     private
        FDate:TDatetime;
        FOccasion:string;
     published
        property Date:TDatetime read FDate write FDate;
        property Occasion:string read FOccasion write FOccasion;
end;

//
//  TCachedCalendar - data-aware calendar that can be wired up to a datasource.
//  Two fields are used to retrieve dates and occasions - DateField and TextField.
//


type
  TCachedCalendar = class(TCalendar)
  private
    FConfigFile:string;
    FUseCache:boolean;
    FDateFieldDataLink:TFieldDataLink;
    FTextFieldDataLink:TFieldDataLink;
    FDateList:TList;
    FDatePopupMenu:TPopupMenu;
    procedure DataChange(Sender:TObject);
    function  GetDataSource:TDataSource;
    function  GetDateField:string;
    function  GetTextField:string;
    procedure SetDataSource(theSource:TDataSource);
    procedure SetDateField(const theFieldName:string);
    procedure SetTextField(const theFieldName:string);
  protected
    procedure Click; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
    function  ReadDatesFromStream:boolean;
    procedure SetUseCache(CacheOnOff:boolean);
    function  WriteDatesToStream:boolean;
  public
    constructor Create(Owner:TComponent);override;
    destructor  Destroy; override;
    function    Refresh:boolean;
  published
    property ConfigFile:string read FConfigFile write FConfigFile;
    property DataSource:TDataSource read GetDataSource write SetDataSource;
    property DateField:string read GetDateField write SetDateField;
    property TextField:string read GetTextField write SetTextField;
    property UseCache:boolean read FUseCache write SetUseCache default false;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('more...', [TCachedCalendar]);
end;

constructor TCachedCalendar.Create(Owner:TComponent);
var
   exePath:string;
begin
     inherited Create(Owner);

     // Configure the two data links required - one for the "special date" field
     // and the other for the occasion text (eg "New Year's Day")

     FDateFieldDataLink:=TFieldDataLink.Create;
     FTextFieldDataLink:=TFieldDataLink.Create;
     FDateFieldDataLink.OnDataChange:=DataChange;
     FTextFieldDataLink.OnDataChange:=DataChange;

     // Default config file used to cache dates between application sessions

     if FConfigFile='' then
       begin
          exePath:=ExtractFilePath(application.exename);
   // ### self.name could also be used if two or more calendars were going to be used in the same application
          FConfigFile:=exePath+'Calendar.cfg';
       end;

     // Register the date list component so Delphi knows how to handle it in file streams

     RegisterClass(TSpecialDateList);

     // Other defaults...

     FDateList:=TList.Create;
     FUseCache:=false;
end;

destructor TCachedCalendar.Destroy;
begin
     // Destroy the data links, component member variables...

     if assigned(FDateFieldDataLink) then
        FDateFieldDataLink.free;
     if assigned(FTextFieldDataLink) then
        FTextFieldDataLink.free;
     FDateList.free;

     // ... and finally call the ancestor's destructor

     inherited Destroy;
end;

procedure TCachedCalendar.SetUseCache(CacheOnOff:boolean);
begin
  // Refresh the calendar whenever the developer switches the calendar mode from
  // cached to not-cached

  if (CacheOnOff=true) then
      ReadDatesFromStream
  else
      Refresh;
end;

function TCachedCalendar.Refresh:boolean;
var
   dSet:TDataset;
   theDate:TDateTime;
   theOccasion:string;
   DateInfo:TSpecialDateList;
begin
// Using the data links already configured, iterate through the result set
// gathering the special dates and occasions

if (assigned(FDateFieldDataLink) and (DataSource<>nil)) then
  begin
    FDateList.clear;
    dSet:=DataSource.Dataset;
    dSet.Active:=true;
    dSet.first;
    while not dSet.eof do
      begin
         DateInfo:=TSpecialDateList.create(Owner);
         DateInfo.Date:=dSet.FieldByName(FDateFieldDataLink.FieldName).AsDatetime;
         DateInfo.Occasion:=dSet.FieldByName(FTextFieldDataLink.FieldName).AsString;
         // Add the dates to the member list - this is used later in DrawCell
         FDateList.add(DateInfo);
         dSet.next;
      end;
    // Record the updated details in the cache for next time...
    Result:=WriteDatesToStream;
  end
else
  Result:=false;
Invalidate;   // Ensure the newly retrieved calendar data is displayed correctly asap
end;

function TCachedCalendar.WriteDatesToStream:boolean;
var
   stream:TfileStream;
   DateInfo:TSpecialDateList;
   c:longint;
begin
  // Check that if file not found for read then exception handled gracefully!
  try
     stream:=TFileStream.create(FConfigFile, fmCreate or fmOpenWrite);
     for c:=0 to (FDateList.count-1) do
       begin
          DateInfo:=FDateList.items[c];
          stream.WriteComponent(DateInfo);
       end;
     stream.free;
     Result:=true;
  except
    on E:exception do
       Result:=false;
  end; // except
end; // function

function TCachedCalendar.ReadDatesFromStream:boolean;
var
   stream:TfileStream;
   ListComponent:TComponent;
begin
  // check that if file not found for read then exception handled gracefully!
  try
     FDateList.clear;
     stream:=TfileStream.create(FConfigFile, fmopenread);
     while not (stream.position = stream.size) do
       begin
         ListComponent:=stream.ReadComponent(nil);
         if (ListComponent is TSpecialDateList) then
           begin
              FDateList.add((ListComponent as TSpecialDateList));
           end;
       end;
     stream.free;
     Result:=true;
  except
    on E:EFOpenError do
       Result:=false;
  end; // except
  Invalidate;   // Ensure the newly retrieved calendar data is displayed correctly asap
end;

// The following functions maintain the datasource and data links references

function TCachedCalendar.GetDateField:string;
begin
  GetDateField:=FDateFieldDataLink.FieldName;
end;

function TCachedCalendar.GetDataSource:TDataSource;
begin
  GetDataSource:=FDateFieldDataLink.DataSource;
end;

procedure TCachedCalendar.SetDateField(const theFieldName:string);
begin
  FDateFieldDataLink.FieldName:=theFieldName;
end;

procedure TCachedCalendar.SetDataSource(theSource: TDataSource);
begin
  FDateFieldDataLink.DataSource:=theSource;
end;

function TCachedCalendar.GetTextField:string;
begin
  GetTextField:=FTextFieldDataLink.FieldName;
end;

procedure TCachedCalendar.SetTextField(const theFieldName:string);
begin
  FTextFieldDataLink.FieldName:=theFieldName;
end;

procedure TCachedCalendar.DataChange(Sender:TObject);
begin
  if FDateFieldDataLink.Field = nil then
    FUseCache:=ReadDatesFromStream;
end;

procedure TCachedCalendar.Notification(AComponent: TComponent; Operation: TOperation);
begin
  // If the datasource is removed from the application, reset the data source reference
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDateFieldDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TCachedCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  CellValue: string;
  CellDate:TDatetime;
  SearchDate:TSpecialDateList;
  d:longint;
begin
   inherited;
   CellValue:=CellText[Acol, ARow];
   // Check to see if this cell represents a "special date" - ignoring the title row (Sun, Mon etc)
   if ((CellValue<>'') and (ARow<>0)) then
    begin
     try
       CellDate:=encodedate(Year, Month, StrToInt(CellValue));
      // Look for the date amongst the list of special dates - though this is iterative, it's quick!
       for d:=0 to (FDateList.count-1) do      // This is done as in-line code rather than a proc for performance
       begin
         SearchDate:=FDateList[d];
         if (SearchDate.Date=CellDate) then
           begin
             // When a "red letter day" is found, paint its cell red!
             Canvas.Brush.Color:=clRed;
             Canvas.font.color:=clBlack;
             with ARect, Canvas do
                 TextRect(ARect, Left + (Right - Left - TextWidth(CellValue)) div 2,
                 Top + (Bottom - Top - TextHeight(CellValue)) div 2, CellValue);
             break; // leave the loop
           end; // if
       end; // for
    except
     on e:exception do showmessage(inttostr(arow))
    end;
  end; // if
end;

procedure TCachedCalendar.Click;
const
  BUTTON_LEFT_OFFSET=10;
  BUTTON_TOP_OFFSET=10;
var
  Point:TPoint;
  CellValue: string;
  CellDate:TDatetime;
  SearchDate:TSpecialDateList;
  d:longint;
begin
  // If the user clicks on a "red letter day", a popup menu appears showing the occasion
  GetCursorPos(Point);
  inherited Click;
  CellValue:=CellText[Col,Row];
  // Check to see if this cell represents a "special date" - ignoring the title row
  if ((CellValue<>'') and (Row<>0)) then
    begin
     try
       CellDate:=encodedate(Year, Month, StrToInt(CellValue));
       // Look for the date amongst the list of special dates - though this is iterative, it's quick!
       for d:=0 to (FDateList.count-1) do      // This is done as in-line code rather than a proc for performance
       begin
         SearchDate:=FDateList[d];
         if (SearchDate.Date=CellDate) then
           begin
             if FDatePopupMenu<>nil
               then FDatePopupMenu.free;
             FDatePopupMenu:=TPopupMenu.Create(Self);
             with FDatePopupMenu.Items do
               begin
                  Add(NewItem((FormatDateTime(LongDateFormat,SearchDate.Date)),0,False,true,nil,0,'PopupMenuItem1'));
                  Add(NewLine);                       // Adds a separator bar
                  Add(NewItem(SearchDate.Occasion,0,False,true,nil,0,'PopupMenuItem2'));
               end; //with
             FDatePopupMenu.Popup((Point.x+BUTTON_LEFT_OFFSET),(Point.y+BUTTON_TOP_OFFSET));
             break; // leave the loop
           end; // if
       end; // for
    except
     on e:exception do showmessage(inttostr(Row))
    end;
  end; // if
end;

end.